home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
vol6n20.arc
/
PROFIL.ARC
/
ENVIRON.PRF
< prev
next >
Wrap
Text File
|
1987-10-31
|
6KB
|
174 lines
type
EnvPtr = ^LongString; { Used to access the environment string }
LongString = array[0..maxint] of char;
var
EnvLength : integer;
MemStr,
EnvStr : EnvPtr;
Extrabytes : integer;
{ Get the length of the DOS environment string }
function GetEnvLength : integer ;
var
Result : integer ;
begin
Inline(
$2E/$A1/$2C/$00 { cs:mov ax,word [$2C] ; get environment segment}
/$8E/$C0 { mov es,ax ; copy it into ES}
/$BF/$00/$00 { mov di,0 ; ES:DI points to first byte}
/$B9/$00/$80 { mov cx,$8000 ; max. length of env. string}
/$FC { cld ; scan upward}
/$B0/$00 { mov al,$00 ; looking for a 0 byte}
/$F2/$AE {rpt: repne scasb}
/$E3/$0D { jcxz error ; if cx=0, we're at end of string}
/$AE { scasb ; check next byte}
/$E3/$0A { jcxz error}
/$75/$F7 { jnz rpt ; continue looping until we get}
{ ; 2 sequential zero bytes}
/$4F { dec di ; mov pointer back to end of string}
/$89/$BE/>RESULT { mov [bp+>Result],di ; return length of string}
/$E9/$06/$00 { jmp end ; and exit}
/$C7/$86/>RESULT/$00/$00{error: mov word [bp+>Result],$0 ; return 0}
{end:}
);
GetEnvLength := Result;
end; { function GetEnvLength }
{ For an array of char pointed to by OldPtr, find the first array element }
{ which is located on a paragraph boundary, and return a pointer with }
{ offset of 0 which points to that element in NewPtr. We have to be able }
{ to do this in order to create a new environment for the called program, }
{ since DOS only transmits the segment of the environment string, thus }
{ requiring environment strings to begin on paragraph boundaries. }
procedure ZeroAdjust( var NewPtr : EnvPtr; OldPtr : EnvPtr );
var
TempOfs,
TempSeg : integer;
begin
TempOfs := ofs( OldPtr^ );
TempSeg := seg( OldPtr^ );
if ( TempOfs and $0F ) <> 0 then
begin
TempOfs := TempOfs and $FFF0;
TempSeg := succ( TempSeg );
end;
TempSeg := TempSeg + ( TempOfs SHR 4 );
TempOfs := 0;
NewPtr := ptr( TempSeg, TempOfs );
end; { procedure ZeroAdjust( var NewPtr : EnvPtr; OldPtr : EnvPtr ) }
{ Allocate on the heap enough space to hold the current environment plus a }
{ string of length NBytes, and set the global variable EnvStr to point to }
{ the first byte in this space which is on a paragraph boundary. }
procedure AllocEnv( NBytes : integer );
begin
EnvLength := GetEnvLength;
If EnvLength > MaxAvail then
begin
WriteLn( 'Environment too large. Program aborted.' );
Halt;
end;
GetMem( MemStr, EnvLength + NBytes + 15 );
ZeroAdjust( EnvStr, MemStr );
end; { procedure AllocEnv( NBytes : integer ) }
{ Copy the environment string into local storage space }
procedure CopyEnv;
var
OldStr : EnvPtr;
begin
OldStr := Ptr( memW[ Cseg:$002C ], 0 );
move( OldStr^, EnvStr^, EnvLength );
end; { procedure CopyEnv }
{ Add the string Str to the local copy of the environment string }
procedure CopyString( Str : string255 );
var
TempPtr : EnvPtr;
StrLen : integer;
begin
StrLen := length( Str );
TempPtr := ptr( seg( EnvStr^ ), EnvLength );
move( Str[1], TempPtr^, StrLen );
EnvStr^[EnvLength + StrLen] := chr(0); { env. string must be terminated by 2 0-bytes }
EnvStr^[EnvLength + StrLen + 1] := chr(0);
end; { procedure CopyString( Str : string255 ) }
{ Make a local copy of the environment string and add the string Str to it, }
{ storing the address of the local copy in EnvStr. }
procedure AddEnvStr( Str : string255 );
begin
Extrabytes := length( Str ) + 2;
AllocEnv( Extrabytes );
CopyEnv;
CopyString( Str );
end; { procedure AddEnvStr( Str : string255 ) }
{ Determine whether the characters in TestString match the characters in }
{ Env beginning at Org. }
function match( Env : LongString; Org : integer; TestString : string255 ) : boolean;
var
Index : integer;
begin
Index := 0;
while ( (Index < length( TestString ) ) and
( Env[ Org + Index ] = TestString[ succ(Index) ] ) ) do
Index := succ(Index);
match := Index = length( TestString );
end; { function match( Env : LongString; Org : integer; TestString : string255 ) }
{ Return the text which follows the first occurence of SearchString in the }
{ program's environment string. Returns an empty string if SearchString }
{ does not occur in the environment string. }
function GetEnvStr( SearchString : string255 ) : string255;
var
CurChar,
Index : integer;
found,
error : boolean;
EnvString : ^Longstring;
OutStr : string255;
begin
CurChar := 0;
found := false;
error := false;
EnvString := ptr( memW[ Cseg:$2C ], 0 );
repeat
if EnvString^[ CurChar ] = chr(0) then
error := true { end of environment string, SearchString not found }
else if match( EnvString^, CurChar, SearchString) then
begin
CurChar := CurChar + length( SearchString );
found := true;
end
else
begin
while EnvString^[ CurChar ] <> chr(0) do
CurChar := succ(CurChar); { Skip to next 0 }
CurChar := succ(CurChar); { Next byte after 0 }
end;
until (found or error);
OutStr := '';
if found then
while EnvString^[ CurChar ] <> chr(0) do
begin
OutStr := OutStr + EnvString^[ CurChar ];
CurChar := succ(CurChar);
end; { while }
GetEnvStr := OutStr;
end; { function GetEnvStr( SearchString : string255 ) }